;;; ABBREV 						-*-LISP-*-

;;;  Helpfun macros:	ABBREVIATION  		for macro-ifying a short name
;;;			ABBREVIATION-DISPLACE	similar, but displaces also
;;;	(ABBREVIATION AC ARRAYCALL |NOT REALLY A SHORT NAME FOR CONS| CONS)
;;;  The latter defines a macro AC such that (AC T FOO 1) becomes
;;;  (ARRAYCALL T FOO 1) after expansion, and so on.  


(DEFUN (ABBREVIATION MACRO) (X) (ABB-MAC-GEN/| X () ))
(DEFUN (ABBREVIATION-DISPLACE MACRO) (X) (ABB-MAC-GEN/| X 'T ))

(DEFUN ABB-MAC-GEN/| (XX DISPLACEP)
  (PROG (Z LONG SHORT X)
	(SETQ X (CDR XX))
    A	(AND (NULL X) 
	     (RETURN (COND ((NULL (CDR Z)) (CAR Z))
			   (`(PROGN 'COMPILE ,@(nreverse z))))))
	(SETQ SHORT (CAR X) LONG (CADR X) X (CDDR X))
    	(AND (OR (NULL SHORT)
		 (NULL LONG) 
		 (NOT (SYMBOLP SHORT)) 
		 (NOT (SYMBOLP LONG)))
	     (ERROR '|Bad ABBREVIATION| XX))
	(PUSH (COND (DISPLACEP 
		     `(DEFUN (,short MACRO) (**MACROARGS**) 
			     (RPLACA **MACROARGS** ',long)))
		    (`(DEFUN (,short MACRO) (**MACROARGS**) 
			     `(,',long . ,(CDR **MACROARGS**)))))
	      Z)
	(GO A)))

ββ